home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / DDPLUS71 / ANSIMENU.ZIP / ANSIMENU.PAS < prev    next >
Pascal/Delphi Source File  |  1995-03-14  |  4KB  |  154 lines
  1. unit AnsiMenu;
  2.  
  3. interface
  4.  
  5. uses crt, DDplus;
  6. type
  7.  menutype = record
  8.              header: string[80];
  9.              footer: string[80];
  10.              headercolor, footercolor, optioncolor, desccolor, arrowcolor: byte;
  11.              bracketcolor: byte;
  12.              numoptions: byte;
  13.              options: array[1..20] of string[1];
  14.              desc: array[1..20] of string[80];
  15.             end;
  16. const
  17.  midscreeny: byte = 12;
  18.  midscreenx: byte = 40;
  19.  
  20. function GetAnsiMenu(menu: menutype): char;
  21.  
  22. implementation
  23.  
  24. function centerstring(s: string): string;
  25. var
  26.  xpos: byte;
  27.  a: integer;
  28. begin;
  29.  xpos:=midscreenx-(length(s) div 2);
  30.  for a:=1 to xpos do s:=' '+s;
  31.  CenterString:=s;
  32. end;
  33.  
  34. procedure Cursor_Forward;
  35. begin;
  36.  if not local then sendtext(#27+'[C');
  37.  gotoxy(wherex+1,wherey);
  38. end;
  39.  
  40. function GetAnsiMenu(menu: menutype): char;
  41. var
  42.  menulength: byte;
  43.  menutop: byte;
  44.  menubottom: byte;
  45.  optiontop: byte;
  46.  optionbottom: byte;
  47.  optionx: word;
  48.  curpos, curoption, oldpos, oldoption: byte;
  49.  a: byte;
  50.  optionselect,ch: char;
  51.  done: boolean;
  52. begin;
  53.  sclrscr;
  54.  done:=false;
  55.  menulength:=menu.NumOptions+4;
  56.  menutop:=midscreeny-(menulength div 2);
  57.  menubottom:=midscreeny+(menulength div 2);
  58.  optiontop:=midscreeny-(menu.numoptions div 2);
  59.  optionbottom:=midscreeny+(menu.numoptions div 2);
  60.  if (menu.numoptions div 2) = (menu.numoptions / 2) then begin;
  61.   optionbottom:=optionbottom-1;
  62.   menubottom:=menubottom-1;
  63.  end;
  64.  optionx:=0;
  65.  for a:=1 to menu.numoptions do optionx:=optionx+(length(menu.options[a])+length(menu.desc[a])+3);
  66.  optionx:=midscreenx-(optionx div menu.numoptions) div 2;
  67.  if color_chg then begin;
  68.   set_foreground(menu.headercolor);
  69.   sgoto_xy(1,menutop);
  70.   swrite(centerstring(menu.header));
  71.   for a:=1 to menu.numoptions do begin;
  72.    sgoto_xy(optionx,optiontop+a-1);
  73.    set_foreground(menu.bracketcolor);
  74.    swrite('[');
  75.    set_foreground(menu.optioncolor);
  76.    swrite(menu.options[a]);
  77.    set_foreground(menu.bracketcolor);
  78.    swrite('] ');
  79.    set_foreground(menu.desccolor);
  80.    swrite(menu.desc[a]);
  81.   end;
  82.   set_foreground(menu.headercolor);
  83.   sgoto_xy(1,menubottom);
  84.   swrite(centerstring(menu.footer));
  85.   curpos:=optiontop;
  86.   curoption:=1;
  87.   oldpos:=curpos;
  88.   oldoption:=curoption;
  89.   sgoto_xy(optionx,curpos);
  90.   set_foreground(menu.arrowcolor);
  91.   swrite('<');
  92.   set_foreground(menu.optioncolor);
  93.   swrite(menu.options[curoption]);
  94.   set_foreground(menu.arrowcolor);
  95.   swrite('>');
  96.   repeat;
  97.    sread_char(ch);
  98.    if ((ch='8') or (ch=#30)) and (wherey>optiontop) then begin;
  99.     curpos:=curpos-1;
  100.     curoption:=curoption-1;
  101.    end;
  102.    if ((ch='2') or (ch=#31)) and (wherey<optionbottom) then begin;
  103.     curpos:=curpos+1;
  104.     curoption:=curoption+1;
  105.    end;
  106.    for a:=1 to menu.numoptions do if upcase(ch)=menu.options[a] then begin;
  107.     curoption:=a;
  108.     curpos:=optiontop+a-1;
  109.     ch:=#13;
  110.    end;
  111.    sgoto_xy(optionx,oldpos);
  112.    set_foreground(menu.bracketcolor);
  113.    swrite('[');
  114.    cursor_forward;
  115.    swrite(']');
  116.    sgoto_xy(optionx,curpos);
  117.    set_foreground(menu.arrowcolor);
  118.    swrite('<');
  119.    cursor_forward;
  120.    swrite('>');
  121.    oldpos:=curpos;
  122.    oldoption:=curoption;
  123.    if ch=#13 then begin;
  124.     optionselect:=menu.options[curoption][1];
  125.     done:=true;
  126.    end;
  127.   until done;
  128.   Getansimenu:=optionselect;
  129.   set_foreground(default_fore);
  130.  end else begin;
  131.   while wherey<menutop do swriteln('');
  132.   swriteln(centerstring(menu.header));
  133.   swriteln('');
  134.   for a:=1 to menu.numoptions do begin;
  135.    while wherex<optionx do swrite(' ');
  136.    swriteln('['+menu.options[a]+']'+' '+menu.desc[a]);
  137.   end;
  138.   swriteln('');
  139.   swrite(centerstring(menu.footer));
  140.   optionselect:=' ';
  141.   repeat;
  142.    sread_char(ch);
  143.    ch:=upcase(ch);
  144.    for a:=1 to menu.numoptions do if ch=menu.options[a] then optionselect:=ch;
  145.   until optionselect<>' ';
  146.   GetAnsiMenu:=optionselect;
  147.  end;
  148. end;
  149.  
  150. end.
  151.  
  152.  
  153.  
  154.